' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2024.09.09.00.00]) on 2025.03.01 at 19:07 (Coordinated Universal Time)
' This program by Charlie Veniot is a port and mod of a QB64 program by b+
_Title "Isometric Bouncing Ball Simulation Claude per issues37" ' 2025-03-01 wow
' Creates a 3D-like environment with balls dropping onto an isometric grid
' and bouncing in random directions before falling off the edge
SCREEN _NEWIMAGE( 760, 580, 27 )
_TITLE "Isometric Bouncing Ball Simulation"
_INITAUDIO
CONST GRID_SIZE = 400 ' Size of the isometric grid
CONST GRAVITY = 0.2 ' Gravity constant
CONST BOUNCE_FACTOR = 0.8 ' Energy retained after bounce
CONST MAX_BALLS = 5 ' Maximum number of active balls
CONST SPAWN_RATE = 3 ' Frames between new ball spawns
CONST X_ADJ = - 260, Y_ADJ = - 160, WHITE = _RGB32( 255, 255, 255 )
' Ball properties
TYPE BallType
x AS SINGLE ' 3D coordinates
y AS SINGLE
z AS SINGLE
vx AS SINGLE ' Velocity components
vy AS SINGLE
vz AS SINGLE
size AS SINGLE ' Ball size in pixels
bcolor AS ULONG ' Ball color
active AS INTEGER ' 1 = active, 0 = inactive
END TYPE
DIM balls( 1 TO MAX_BALLS ) AS BallType
DIM frameCounter AS INTEGER
DIM ballsCreated AS INTEGER
' Origin of isometric grid (center of screen, base level)
CONST ORIGIN_X = 640, ORIGIN_Y = 500
DECLARE SUB CreateNewBall
DECLARE SUB DrawIsometricGrid
DECLARE SUB ProcessBalls
DECLARE SUB Convert3DToScreen (x AS SINGLE, y AS SINGLE, z AS SINGLE, screenX AS INTEGER, screenY AS INTEGER)
DECLARE Sub Line3D (x1 AS SINGLE, y1 AS SINGLE, z1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, z2 AS SINGLE, c AS ULONG)
' Main program loop
DO
CLS
CALL DrawIsometricGrid
CALL ProcessBalls
' Spawn new balls at regular intervals
frameCounter = frameCounter + 1
IF frameCounter MOD SPAWN_RATE = 0 _
AND ballsCreated < MAX_BALLS _
THEN CreateNewBall
SLEEP 0.015
LOOP
END
SUB CreateNewBall
DIM i AS INTEGER
' Find an available slot for a new ball
FOR i = 1 TO MAX_BALLS
IF balls(i).active = 0 THEN
' Initialize ball properties
balls(i).x = 0 : balls(i).y = 0 : balls(i).z = 300
balls(i).vx = ( RND - 0.5 ) * 2 ' Small random initial velocity
balls(i).vy = ( RND - 0.5 ) * 2 : balls(i).vz = 0
balls(i).size = 5 + INT( RND * 8 )
balls(i).bcolor = _RGB32( 128 + RND * 127, 128 + RND * 127, 128 + RND * 127)
balls(i).active = 1
ballsCreated = ballsCreated + 1
i = MAX_BALLS + 1
END IF
NEXT i
END SUB
' Draw isometric grid
SUB DrawIsometricGrid
DIM AS INTEGER x, y, screenX, screenY, gridStep
gridStep = 50 ' Space between grid lines
' Draw grid lines
FOR x = ( -GRID_SIZE / 2 ) TO ( GRID_SIZE / 2 ) STEP gridStep
' Draw line along the x-axis
CALL Line3D( x, ( -GRID_SIZE / 2 ), 0, x, ( GRID_SIZE / 2 ), 0, WHITE )
' Draw line along the y-axis
CALL Line3D( ( - GRID_SIZE / 2 ), x, 0, ( GRID_SIZE / 2 ), x, 0, WHITE )
NEXT x
END SUB
' Process and draw all active balls
SUB ProcessBalls
DIM AS INTEGER i, screenX, screenY
FOR i = 1 TO MAX_BALLS
IF balls(i).active = 1 THEN
' Apply gravity
balls(i).vz = balls(i).vz - GRAVITY
' Update position
balls(i).x = balls(i).x + balls(i).vx
balls(i).y = balls(i).y + balls(i).vy
balls(i).z = balls(i).z + balls(i).vz
' Check for collision with the floor
IF balls(i).z <= 0 THEN
' Bounce on the grid
balls(i).z = 0
balls(i).vz = -balls(i).vz * BOUNCE_FACTOR
IF balls(i).vz > 0.15 THEN SOUND (300 - balls(i).size * 20 ), 1
' Add random horizontal movement after bounce
balls(i).vx = balls(i).vx + ( RND - 0.5 ) * 3
balls(i).vy = balls(i).vy + ( RND - 0.5 ) * 3
END IF
' Check if ball is outside grid boundaries
IF ABS( balls(i).x ) > GRID_SIZE / 2 _
OR ABS( balls(i).y ) > GRID_SIZE / 2 _
THEN
' Reset ball position to top
balls(i).x = 0
balls(i).y = 0
balls(i).z = 300
balls(i).vx = ( RND - 0.5 ) * 2
balls(i).vy = ( RND - 0.5 ) * 2
balls(i).vz = 0
END IF
' Convert 3D coordinates to isometric screen position
' and draw the ball
CALL Convert3DToScreen( balls(i).x, balls(i).y, balls(i).z, screenX, screenY )
CIRCLE( screenX, screenY ), balls(i).size, balls(i).bcolor
PAINT( screenX, screenY ), balls(i).bcolor, balls(i).bcolor
END IF
NEXT i
END SUB
' Convert 3D coordinates to isometric screen coordinates
SUB Convert3DToScreen( x AS SINGLE, y AS SINGLE, z AS SINGLE, screenX AS INTEGER, screenY AS INTEGER )
' Isometric projection factors
CONST ISO_X1 = 0.866 ' cos(30?)
CONST ISO_X2 = 0.866 ' cos(30?)
CONST ISO_Y1 = 0.5 ' sin(30?)
CONST ISO_Y2 = -0.5 ' -sin(30?)
' Convert 3D to isometric 2D
screenX = ORIGIN_X + X_ADJ + ( x * ISO_X1 + y * ISO_X2 )
screenY = ORIGIN_Y + Y_ADJ + ( x * ISO_Y1 + y * ISO_Y2 ) - z
END SUB
' Draw a line in 3D space
SUB Line3D( x1 AS SINGLE, y1 AS SINGLE, z1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, z2 AS SINGLE, c AS ULONG )
DIM AS INTEGER sx1, sy1, sx2, sy2
' Convert 3D points to screen coordinates
CALL Convert3DToScreen( x1, y1, z1, sx1, sy1 )
CALL Convert3DToScreen( x2, y2, z2, sx2, sy2 )
' Draw the line
LINE ( sx1, sy1 ) - ( sx2, sy2 ), c
END SUB